perm filename UNDER[POX,WD]1 blob sn#358978 filedate 1978-05-31 generic text, type T, neo UTF8
00100	\|\\;				Define Brick Character
00200	\M0FIX25;\;	fixed font
00300	\⊂'000040;\;	VERREM - REM's syntax form macros with args definitions
00400	\⊂'000400;\;	VERRHT - modified way to pass args with nest chars
00500	\8EVAL(STRING)[⊗STRING⊗]\;
00600	\8OMIT(STRING)[]\;
00700	\8SETOM(REG)[\P\←=1;\→⊗REG⊗\p]\;	set REG to one
00800	\8SETZM(REG)[\P\←=0;\→⊗REG⊗\p]\;	set REG to zero
00900	\8LOADAC(VAR)[\!EVAL((\←=)\!⊗VAR⊗;(;));]\;	load ac with var
01000	\∞TRACEAC[\!EVAL((\m{)(ac=)\D∀( )(}));]\;	trace ac
01100	\;
01200	\8INCR(VAR)[\N			increment variable
01300	\	;\P\N				save ac
01400	\	;\!LOADAC(⊗VAR⊗);\N		load ac with var
01500	\	;\!EVAL((\∂←)⊗VAR⊗(;));\N	expunge old var def
01600	\	;\+=1;\N			add 1 to ac
01700	\	;\!EVAL((\∞)⊗VAR⊗([)\D∀(]));\N
01800	\	;\N				redefine var
01900	\	;\p]\;				restore ac
02000	\;
02100	\8COMPAC(ARG)[\N		complement ac
02200	\	;\!EVAL(⊗ARG⊗);\N		evaluate argument
02300	\	;\Q0\N				save reg 0
02400	\	;\!SETOM(0);\N			put a 1 in reg 0
02500	\	;\?SETZM(0);\N			if ac > 0 set reg 0 to 0
02600	\	;\←0\N				load ac from reg 0
02700	\	;\q0]\;				restore reg 0
02800	\;
02900	\∞ISACZERO[\N			is ac zero
03000	\	;\Q0\N				save qreg 0
03100	\	;\→0\N				store ac in 0
03200	\	;\*0\N				mult ac by qreg 0
03300	\	;\!COMPAC;\N			complement ac
03400	\	;\q0]\;				restore qreg 0
03500	\;
03600	\8LENGTH(STRING)[\N		length of string
03700	\	;\Q0\N				save reg 0
03800	\	;\oSP{0 }\N			put a space in an overlay
03900	\	;\7SP;\N			width of space to ac
04000	\	;\∂←SP;\N			expunge overlay
04100	\	;\→0\N				store ac in reg 0
04200	\	;\oSTR{0 ⊗STRING⊗}\N		put string in overlay
04300	\	;\7STR;\N			width of string to ac
04400	\	;\∂←STR;\N			expunge overlay
04500	\	;\-0\N				subtract off width of space
04600	\	;\/0\N				divide by width of space
04700	\	;\q0]\;				restore reg 0
04800	\;
04900	\8NULL(STRING)[\!COMPAC(\!LENGTH(⊗STRING⊗););]\N
05000	\;
05100	\8FIRST(STRING)[\N		first character of a string
05200	\	;\P\N				save ac
05300	\	;\!OMIT(\a⊗STRING⊗);\N	ascii of 1st char to ac
05400	\	;\N				and flush rest of string
05500	\	;\A∀\N				make char from ac
05600	\	;\p]\;				restore ac
05700	\;
05800	\8REST(STRING)[\N		rest of a string
05900	\	;\P\N				save ac
06000	\	;\a⊗STRING⊗\N			carve off 1st char
06100	\	;\p]\;				restore ac
06200	\;
06300	\8MAPFIRST(MAC,STR)[\N		apply macro to each char of string
06400	\	;\P\N				save ac
06500	\	;\!COMPAC(\!NULL(⊗STR⊗););\N	if string is not null
06600	\	;\?⊗MAC⊗(\?FIRST(⊗STR⊗););\N
06700	\	;\N				apply macro to first char
06800	\	;\?MAPFIRST(⊗MAC⊗,\?REST(⊗STR⊗););\N
06900	\	;\N				apply macro to rest of string
07000	\	;\p]\;				restore ac
07100	\;
07200	\8ISCRLF(CHAR)[\N		is char a cr or lf
07300	\	;\a⊗CHAR⊗\N			ascii of char to ac
07400	\	;\P\N				push ac
07500	\	;\-=13;\N			sub ascii of cr from ac
07600	\	;\!COMPAC(\!ISACZERO;);\N	was it a cr
07700	\	;\?EVAL((\p\N				get back ascii of char
07800	\		;\-=10;\N			sub ascii of lf
07900	\		;\!COMPAC(\!ISACZERO;);));\N	was it a lf
08000	\	;\!COMPAC;]\;			restore pos logic
08100	\;
08200	\8UNDERLINE(STR)[\!MAPFIRST(UNDERLINECHAR,⊗STR⊗);]\;
08300	\;
08400	\8UNDERLINECHAR(CHAR)[\N	underline non crlf chars
08500	\	;\P\N				save ac
08600	\	;\!COMPAC(\!ISCRLF(⊗CHAR⊗););\N	if not cr or lf
08700	\	;\?UNDERLINECHAR1(⊗CHAR⊗);\N	underline it
08800	\	;\!COMPAC;\N			complement ac
08900	\	;\?INCR(UNDCNT);\N
09000	\	;\?EVAL(⊗CHAR⊗);\N		pass bare char
09100	\	;\p]\;				restore ac
09200	\;
09300	\8UNDERLINECHAR1(CHAR)[\[=2;=2;⊗CHAR⊗\]]\;
09400	\8UNDERLINECHAR1(CHAR)[\N	*****
09500	\	;\[=2;=2;⊗CHAR⊗\]\N
09600	\	;\!INCR(UNDCNT);
09700	\!EVAL((\m{)\!UNDCNT;( )(}));]\;
09800	\∞UNDCNT[0]\;		*****
09900	\;
10000	\∞FOO[\N		macro to iterate underline
10100	\	;\-=1;\N		decrement count
10200	\	;\P\N
10300	\	;\!UNDERLINE(a);\N
10400	
10500	\	;\p]\;
10600	\←=1000;\;		iteration count
10700	\IFOO;\;
10800	\8PRINTCHARS(STR)[\!MAPFIRST(PRINTCHAR,⊗STR⊗);]\;
10900	\;
11000	\8PRINTCHAR(CH)[
11100	\	;\P\N			save ac
11200	\	;\a⊗CH⊗\N			ascii of char to ac
11300	\	;\!EVAL((\m{)\D∀( )(}));\N	trace ac
11400	\	;\!ISCRLF(⊗CH⊗);\N
11500	\	;\!EVAL((\m{)\D∀( )(}));\N	trace ac
11600	\	;\p]\;			restore ac
11700	\;